home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Parse.bas < prev    next >
BASIC Source File  |  1997-06-14  |  4KB  |  157 lines
  1. Attribute VB_Name = "MParse"
  2. Option Explicit
  3.  
  4. Public Enum EErrorParse
  5.     eeBaseParse = 13550
  6. End Enum
  7.  
  8. Function GetQToken(sTarget As String, sSeps As String) As String
  9.     ' Assume failure
  10.     GetQToken = sEmpty
  11.  
  12.     ' Note that sSave and iStart must be static from call to call
  13.     ' If first call, make copy of string
  14.     Static sSave As String, iStart As Integer, cSave As Integer
  15.     Dim iNew As Integer, fQuote As Integer
  16.     If (sTarget <> sEmpty) Then
  17.         iStart = 1
  18.         sSave = sTarget
  19.         cSave = Len(sSave)
  20.     Else
  21.         If sSave = sEmpty Then Exit Function
  22.     End If
  23.     ' Make sure separators includes quote
  24.     sSeps = sSeps & sQuote2
  25.  
  26.     ' Find start of next token
  27.     iNew = StrSpan(sSave, iStart, sSeps)
  28.     If iNew Then
  29.         ' Set position to start of token
  30.         iStart = iNew
  31.     Else
  32.         ' If no new token, return empty string
  33.         sSave = sEmpty
  34.         Exit Function
  35.     End If
  36.     
  37.     ' Find end of token
  38.     If (iStart = 1) Then
  39.         iNew = StrBreak(sSave, iStart, sSeps)
  40.     ElseIf Mid$(sSave, iStart - 1, 1) = sQuote2 Then
  41.         iNew = StrBreak(sSave, iStart, sQuote2)
  42.     Else
  43.         iNew = StrBreak(sSave, iStart, sSeps)
  44.     End If
  45.  
  46.     If iNew = 0 Then
  47.         ' If no end of token, set to end of string
  48.         iNew = cSave + 1
  49.     End If
  50.     ' Cut token out of sTarget string
  51.     GetQToken = Mid$(sSave, iStart, iNew - iStart)
  52.     
  53.     ' Set new starting position
  54.     iStart = iNew
  55.  
  56. End Function
  57.  
  58. Function GetToken(sTarget As String, sSeps As String) As String
  59.     
  60.     ' Assume failure
  61.     GetToken = sEmpty
  62.     
  63.     ' Note that sSave and iStart must be static from call to call
  64.     ' If first call, make copy of string
  65.     Static sSave As String, iStart As Integer, cSave As Integer
  66.     
  67.     If sTarget <> sEmpty Then
  68.         iStart = 1
  69.         sSave = sTarget
  70.         cSave = Len(sSave)
  71.     Else
  72.         If sSave = sEmpty Then Exit Function
  73.     End If
  74.     
  75.     ' Find start of next token
  76.     Dim iNew As Integer
  77.     iNew = StrSpan(sSave, iStart, sSeps)
  78.     If iNew Then
  79.         ' Set position to start of token
  80.         iStart = iNew
  81.     Else
  82.         ' If no new token, return empty string
  83.         sSave = sEmpty
  84.         Exit Function
  85.     End If
  86.     
  87.     ' Find end of token
  88.     iNew = StrBreak(sSave, iStart, sSeps)
  89.     If iNew = 0 Then
  90.         ' If no end of token, set to end of string
  91.         iNew = cSave + 1
  92.     End If
  93.     
  94.     ' Cut token out of sTarget string
  95.     GetToken = Mid$(sSave, iStart, iNew - iStart)
  96.     ' Set new starting position
  97.     iStart = iNew
  98.  
  99. End Function
  100.  
  101. Function StrBreak(sTarget As String, ByVal iStart As Integer, sSeps As String) As Integer
  102.     
  103.     Dim cTarget As Integer
  104.     cTarget = Len(sTarget)
  105.    
  106.     ' Look for end of token (first character that is a separator)
  107.     Do While InStr(sSeps, Mid$(sTarget, iStart, 1)) = 0
  108.         If iStart > cTarget Then
  109.             StrBreak = 0
  110.             Exit Function
  111.         Else
  112.             iStart = iStart + 1
  113.         End If
  114.     Loop
  115.     StrBreak = iStart
  116.  
  117. End Function
  118.  
  119. Function StrSpan(sTarget As String, ByVal iStart As Integer, sSeps As String) As Integer
  120.     
  121.     Dim cTarget As Integer
  122.     cTarget = Len(sTarget)
  123.     ' Look for start of token (character that isn't a separator)
  124.     Do While InStr(sSeps, Mid$(sTarget, iStart, 1))
  125.         If iStart > cTarget Then
  126.             StrSpan = 0
  127.             Exit Function
  128.         Else
  129.             iStart = iStart + 1
  130.         End If
  131.     Loop
  132.     StrSpan = iStart
  133.  
  134. End Function
  135. '
  136.  
  137. #If fComponent = 0 Then
  138. Private Sub ErrRaise(e As Long)
  139.     Dim sText As String, sSource As String
  140.     If e > 1000 Then
  141.         sSource = App.ExeName & ".Parse"
  142.         Select Case e
  143.         Case eeBaseParse
  144.             BugAssert True
  145.        ' Case ee...
  146.        '     Add additional errors
  147.         End Select
  148.         Err.Raise COMError(e), sSource, sText
  149.     Else
  150.         ' Raise standard Visual Basic error
  151.         sSource = App.ExeName & ".VBError"
  152.         Err.Raise e, sSource
  153.     End If
  154. End Sub
  155. #End If
  156.  
  157.